{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses,
             FunctionalDependencies, TypeFamilies, ViewPatterns,
             FlexibleInstances #-}

module Var (
    CVar(..), CFun(..), CVarID, AddressingMode(..),
    VarR(..), FunR(..), newResolvedVar,
    VarView(..), FunView(..), getFunArity, funName
    ) where

import Control.Applicative
import Control.Monad.Trans (MonadIO(..))

import MValue
import ID
import Eval
import Types
import Located (unLoc)

------------------------------------------------------------------------------

class VarResolved r where
    newResolvedVar :: IO r

instance VarResolved CVarID where newResolvedVar = mkID <$> newUnique
instance VarResolved (IORef Value) where newResolvedVar = newMValue Nil

-- Since the module linking code will have to work with different types of
-- Var and Fun for interpreted and compiled code, here are some classes to
-- deal with these data types abstractly.
--
-- `rv' is The actual type of a variable exported by a module.
-- (e.g. IORef Value for the intepreter, CVarID for the compiler.)
class VarResolved r => VarR r v | v -> r where

    mkNamedVar :: LName -> v
    mkLocalVar :: Int -> v
    mkArgVar :: Int -> v
    mkRefArgVar :: Int -> v
    mkResolvedVar :: r -> v
    
    viewVar :: v -> VarView r v
    varName :: v -> Maybe LName

-- There are also view data types and view functions for using the ViewPatterns
-- to continue using pattern matching.
data VarView r v
    = VNamedVar LName
    | VLocalVar Int
    | VArgVar Int
    | VRefArgVar Int
    | VResolvedVar r
    | VOtherVar v

instance VarR (IORef Value) IVar where
    mkNamedVar = INamedVar
    mkLocalVar = ILocalVar
    mkArgVar = IArgVar
    mkRefArgVar = IRefArgVar
    mkResolvedVar = IResolvedVar

    viewVar (INamedVar n) = VNamedVar n
    viewVar (ILocalVar i) = VLocalVar i
    viewVar (IArgVar i) = VArgVar i
    viewVar (IRefArgVar i) = VRefArgVar i
    viewVar (IResolvedVar r) = VResolvedVar r
    viewVar x = VOtherVar x
    
    varName (INamedVar n) = Just n
    varName _ = Nothing

------------------------------------------------------------------------------

class VarR r v => FunR r v f | f -> v r where
    type NativeFunT f :: *

    mkNamedFun :: LName -> Arity -> f
    mkResolvedFun :: Name -> IORef (Function v f) -> f
    -- mkNativeFun is not needed because native functions aren't actually generated by the interpreter/compiler.
    viewFun :: f -> FunView v f
 
data FunView v f
    = VNamedFun LName Arity
    | VResolvedFun Name (IORef (Function v f))
    | VNativeFun Name Arity (NativeFunT f)

instance FunR (IORef Value) IVar IFun where
    type NativeFunT IFun = [IVar] -> [Value] -> Eval Value

    mkNamedFun n a = INamedFun n a
    mkResolvedFun n r = IResolvedFun n r

    viewFun (INamedFun n a) = VNamedFun n a
    viewFun (IResolvedFun n r) = VResolvedFun n r
    viewFun (INativeFun n a f) = VNativeFun n a f

getFunArity :: (FunR r v f, MonadIO m) => f -> m Arity
getFunArity f = case viewFun f of
    VNamedFun _ a -> return a
    VResolvedFun _ ref -> liftIO $ funArity <$> readMValue ref
    VNativeFun _ a _ -> return a
    
funName f = case viewFun f of
    VNamedFun n _ -> unLoc n
    VResolvedFun n _ -> n
    VNativeFun n _ _ -> n

------------------------------------------------------------------------------

newtype CVarID = CVarID Unique deriving (ID, Ord, Eq)
instance Show CVarID where show x = "<CVarID>"

data AddressingMode
    = Direct
    | Indirect
    deriving Show

data CVar
    = CNamedVar LName
    | CLocalVar Int
    | CArgVar Int
    | CRefArgVar Int
    | CModuleVar CVarID
    | CStackVar AddressingMode Int  
    deriving Show
    
data CFun
    = CNamedFun LName Arity
    | CFun (IORef (Function CVar CFun))
    | CNative Arity LName LName -- e.g. CNative (0,2) "KJARNI" "+"

instance Show CFun where show x = "<CFun>"
